SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00017 CRT ROUTINES 1 05-28-9313:36ALL SWAG SUPPORT TEAM XY Cursor Position in ASMIMPORT 15 {π> If anyone is interested in the BAsm GotoXY/WhereX/WhereY routinesπ> I'll be happy to post them. They use standard BIOS routines, andππI simply followed an Interrupt listing I had to create these Functions.ππNote the DEC commands in GotoXY, and the INC command in Each WHERE* Function.πThese are there to make the Procedures/Functions Compatible With the TP Crtπroutines, which are 1-based. (ie: 1,1 in TP.Crt is upper left hand corner).πThe BIOS routines need to be given 0,0 For the same coordinates. If you don'tπwant to remain Compatible With Turbo's GotoXY and WHERE* Functions, delete themπout and keep your code Zero-based For X/Y screen coords.π}ππProcedure GotoXY(X,Y : Byte); Assembler; Asmπ MOV DH, Y { DH = Row (Y) }π MOV DL, X { DL = Column (X) }π DEC DH { Adjust For Zero-based Bios routines }π DEC DL { Turbo Crt.GotoXY is 1-based }π MOV BH,0 { Display page 0 }π MOV AH,2 { Call For SET CURSOR POSITION }π INT 10hπend;ππFunction WhereX : Byte; Assembler;πAsmπ MOV AH,3 {Ask For current cursor position}π MOV BH,0 { On page 0 }π INT 10h { Return inFormation in DX }π INC DL { Bios Assumes Zero-based. Crt.WhereX Uses 1 based }π MOV AL, DL { Return X position in AL For use in Byte Result }πend;ππFunction WhereY : Byte; Assembler;πAsmπ MOV AH,3 {Ask For current cursor position}π MOV BH,0 { On page 0 }π INT 10h { Return inFormation in DX }π INC DH { Bios Assumes Zero-based. Crt.WhereY Uses 1 based }π MOV AL, DH { Return Y position in AL For use in Byte Result }πend;ππ{πNote that the WhereX and WhereY Function call the exact same Bios function.π}π 2 05-28-9313:36ALL SWAG SUPPORT TEAM Set EGA/VGA Blink Bit IMPORT 13 π Hi, Rolfi:ππRM>Anybody know and easy way to do DarkGrey for a bkgrnd???ππ ...You have to turn off the "blink-bit", if possible. This isπ only available for CGA and EGA/VGA color text modes.ππ (***** Turn the "blink-bit" on/off to allow 16 different background *)π (* colors. (CGA ONLY!) *)π (* *)π procedure SetBlinkCGA({input } TurnOn : boolean);π beginπ if TurnOn thenπ beginπ mem[$0040:$0065] := (mem[$0040:$0065] AND (NOT $20));π port[$3D8] := $29π endπ elseπ beginπ mem[$0040:$0065] := (mem[$0040:$0065] OR $20);π port[$3D8] := $09π endπ end; (* SetBlinkCGA. *)πππ (***** Turn the "blink-bit" on/off to allow 16 different background *)π (* colors. (EGA or VGA ONLY!) *)π (* *)π procedure SetBlinkEGAVGA({input } TurnOn : boolean);π beginπ asmπ mov ax, 1003hπ mov bl, TurnOnπ int 10hπ endπ end; (* SetBlinkEGAVGA. *)ππ - Guyπ---π ■ DeLuxe²/386 1.25 #5060 ■π * Rose Media, Toronto, Canada : 416-733-2285π * PostLink(tm) v1.04 ROSE (#1047) : RelayNet(tm)ππ 3 05-28-9313:36ALL SWAG SUPPORT TEAM Clear CRT Screen FAST IMPORT 3 {π>Does anyone know how to clear the screen Really fast ?πWell, here is some Asm code but I haven't tested it. It should work:π}ππProcedure FastClrScr; Assembler;πAsmπ MOV AH,0Fhπ INT 10hπ MOV AH,0π INT 10hπend;ππbeginπ FastClrScr;πend. 4 05-28-9313:36ALL SWAG SUPPORT TEAM Clear VGA Screen IMPORT 6 {π>> Does anyone know how to clear the screen Really fast ?π>> I'm working in VGA-mode With a resolution of 320*200*256π> You could try a block rewriting of the palettes, but that would probablyπ> take even longer, since it is usually an interrupt instruction.ππWell, use the standard pascal routine called FillChar. ;-)π}ππFillChar(Mem[$A000:$0000],320*200,0);ππ{ You can double speed by using 16 bit wide data transfer: }ππProcedure FillChar16(Var X;Count : Word;Value : Byte); Assembler;πAsmπ les di,Xπ mov cd,Countπ shr cx,1π mov al,Valueπ mov ah,alπ rep stoswπ test Count,1π jz @endπ stosbπ@end:πend;ππ 5 05-28-9313:36ALL SWAG SUPPORT TEAM CPU Delay IMPORT 4 {π> does anyone have an accurate BAsm Delay routine that isπ> compatible With the one in the Crt Unit? please post it...π}ππProcedure Delay(ms : Word); Assembler;πAsm {machine independent Delay Function}π mov ax, 1000;π mul ms;π mov cx, dx;π mov dx, ax;π mov ah, $86;π int $15;πend;π 6 05-28-9313:36ALL SWAG SUPPORT TEAM Reading Keys IMPORT 5 {π> Could someone please post an Asm equivalent ofπ> Repeat Until KeyPressed;ππWell, here it is using the Dos Unit instead of the Crt.... :)π}πUses Dos;πVarπ r : Registers;ππFunction _ReadKey : Char;πbeginπ r.ax := $0700;π intr($21, r);π _ReadKey := chr(r.al);πend;ππFunction _KeyPressed : Boolean;πbeginπ r.ax := $0b00;π intr($21,r);π if r.al = 255 thenπ _KeyPressed := Trueπ elseπ _KeyPressed := False;πend;πbeginπ Repeat Until _keypressed;πend. 7 05-28-9313:36ALL SWAG SUPPORT TEAM Check KEYPRESS IMPORT 15 {πTo the person that posted the message about using KeyPressed or anyoneπelse interested. Below is a Function that I have used to read keyboard inputπthat is similiar to KeyPressed. It does a KeyPressed and ReadKey all in oneπstatement. If you are familiar With BASIC this InKey Function is similiarπto the one in BASIC in that is doesn't sit and wait For input. The KeyEnhπFunction just returns True/False depending on whether or not it detectedπan Enhanced keyboard. SHIFT, CTRL, and ALT are global Boolean Variablesπwhich value reflect the state of these keys involved in the the keypress.π}ππUsesπ Dos;ππFunction KeyEnh: Boolean;πVarπ Enh: Byte Absolute $0040:$0096;ππbeginπ KeyEnh := False;π if (Enh and $10) = $10 thenπ KeyEnh := True;πend;ππFunction InKey(Var SCAN, ASCII: Byte): Boolean;πVarπ i : Integer;π Shift,π Ctrl,π Alt : Boolean;π Temp,π Flag1 : Byte;π HEXCH,π HEXRD,π HEXFL : Byte;π reg : Registers;ππbeginπ if KeyEnh thenπ beginπ HEXCH := $11;π HEXRD := $10;π HEXFL := $12;π endπ elseπ beginπ HEXCH := $01;π HEXRD := $00;π HEXFL := $02;π end;ππ reg.ah := HEXCH;π Intr($16, reg);π i := reg.flags and FZero;ππ reg.ah := HEXFL;π Intr($16, reg);π Flag1 := Reg.al;π Temp := Flag1 and $03;ππ if Temp = 0 thenπ SHIFT := Falseπ ELSEπ SHIFT := True;ππ Temp := Flag1 and $04;π if Temp = 0 thenπ CTRL := Falseπ ELSEπ CTRL := True;ππ Temp := Flag1 and $08;π if Temp = 0 Thenπ ALT := Falseπ ELSEπ ALT := True;ππ if i = 0 thenπ beginπ reg.ah := HEXRD;π Intr($16, reg);π scan := reg.ah;π ascii := reg.al;π InKey := True;π endπ elseπ InKey := False;πend;πππVarπ Hi, Hi2 : Byte;ππbeginπ Repeat Until InKey(Hi,Hi2);π Writeln(Hi);π Writeln(Hi2);πend. 8 05-28-9313:36ALL SWAG SUPPORT TEAM Readkey and KEYPRESS IMPORT 7 {πCrt Unit, but I don't want to use the Crt. Could some one showπme a routine For Pause, or Delay With a Time Factor?ππ ...I can supply you With KeyPressed and ReadKey routines Forπ TP6 or TP7, which could be used to create a Pause routine.π The Delay is a bit harder, I've got a routine I wrote lastπ year For this, but I'm still not happy With it's accuracy.π}ππ{ Read a key-press. }πFunction ReadKeyChar : {output} Char; Assembler;πAsmπ mov ah, 00hπ int 16hπend; { ReadKeyChar. }ππ{ Function to indicate if a key is in the keyboard buffer. }πFunction KeyPressed : {output} Boolean; Assembler;πAsmπ mov ah, 01hπ int 16hπ mov ax, 00hπ jz #1π inc axπ @1:πend; { KeyPressed. }π 9 05-28-9313:36ALL SWAG SUPPORT TEAM Small CRT Replacement IMPORT 30 Unit sCrt;ππ{ππ by Trevor J Carlsenπ PO Box 568π Port Hedlandπ Western Australia 6721π Phone -π Voice: 61 91 732026π Data : 61 91 732569ππ This little Unit is intended to replace the Crt Unit in Programs that doπ not require many of that Units Functions. As a result the resulting .exeπ code is much smaller.ππ Released into the public domain 1989ππ}ππInterfaceππFunction KeyPressed: Boolean;π { Returns True if there is a keystroke waiting in the key buffer }ππProcedure ClrScr;π { Clears the screen and homes the cursor }ππProcedure ClrKey;π { Flushes the keystroke buffer }ππFunction KeyWord : Word;π Inline ($B4/$00/ {mov ah,0}π $CD/$16); {int 16h}π { Waits For a keypress and returns a Word containing the scancode and }π { ascii code For the KeyPressed }ππFunction ExtKey(Var k : Char; Var s : Byte): Boolean;π { Gets next keystroke from the keystroke buffer. if it was an Extended key }π { (ie. Function key etc.) returns True and k contains the scan code. if a }π { normal key then returns False and k contains the Character and s the scan}π { code }ππFunction ReadKey: Char;π { Gets next keystroke from the buffer. if Extended key returns #0 }ππFunction NextKey: Char;π { Flushes the keystroke buffer and then returns the next key as ReadKey }ππFunction PeekKey: Char;π { Peeks at the next keypress in the buffer without removing it }ππProcedure Delay(s : Word);π { Machine independent Delay loop For s seconds }ππProcedure GotoXY(x,y : Byte);π { Moves the cursor to X, y coordinates }ππ{ -------------------------------------------------------------------------- }ππImplementationππUses Dos;ππVarπ head : Word Absolute $0040:$001A;π tail : Word Absolute $0040:$001C;π time : LongInt Absolute $0040:$006C;π regs : Registers;ππFunction KeyPressed: Boolean;π beginπ KeyPressed := (tail <> head);π end;ππProcedure ClrScr; { 25 line display only }π beginπ Inline($B4/$06/$B0/$19/$B7/$07/$B5/$00/$B1/$00/$B6/$19/$B2/$4F/π $CD/$10/$B4/$02/$B7/$00/$B2/$00/$B6/$00/$CD/$10);π end;ππProcedure ClrKey;π beginπ head := tail;π end;πππFunction ExtKey(Var k : Char; Var s : Byte): Boolean;ππ Varπ keycode : Word;π al : Byte;π ah : Byte;ππ beginπ ExtKey := False;π Repeatπ keycode := KeyWord;π al := lo(keycode);π ah := hi(keycode);π if al = 0 then beginπ ExtKey := True;π al := ah;π end;π Until al <> 0;π k := chr(al);π s := al;πend; {ExtKey}ππFunction ReadKey : Char;π Varπ Key : Byte;π beginπ Key := lo(KeyWord);π ReadKey := Char(Key);π end;ππFunction NextKey : Char;π beginπ tail := head;π NextKey := ReadKey;π end;ππFunction PeekKey : Char;π beginπ PeekKey := Char(Mem[$40:head]);π end;ππProcedure Delay(s : Word);π Varπ start : LongInt;π finished : Boolean;π beginπ start := time;π Repeatπ if time < start then { midnight rollover occurred during the period }π dec(start,$1800B0);π finished := (time > (start + s * 18.2));π Until finished;π end;ππProcedure GotoXY(x,y : Byte);π beginπ With regs do beginπ ah := $02;π bh := 0;π dh := pred(y);π dl := pred(x);π intr($10,regs);π end; { With }π end; { GotoXY }ππend.π πππ 10 09-26-9310:10ALL GREG ESTABROOKS Blink, Color & Chars SWAG9311 14 ▐« (*πFrom: GREG ESTABROOKSπSubj: BLINK, COLOURS AND CHARACTERSπ*)ππPROGRAM BlinkBitDemo; { Aug 31/93, Greg Estabrooks. }πUSES CRT; { Clrscr,TextAttr. }πVARπ Loop1, Loop2, TextA : BYTE;ππPROCEDURE SetBlinkBit( OffOn :BOOLEAN ); ASSEMBLER;π { Routine to turn the blink bit on/off.}πASMπ Push AX { Save AX. }π Mov AX,$1003 { Video routine to toggle bit.}π Mov BL,OffOn { Move OffOn value in BL. }π Int $10 { Call video Interrupt. }π Pop AX { Restore AX. }πEND;{SetBlinkBit}ππBEGINπ ClrScr; { Clear up screen clutter. }π TextA := 0; { Initiate color number. }π FOR Loop1 := 0 TO 15 DO { Now draw color chart. }π BEGINπ FOR Loop2 := 0 TO 15 DOπ BEGINπ TextAttr := TextA; { Set new color. }π Write(TextA:4); { Write new color number. }π Inc(TextA); { Move to next color. }π END;π Writeln; { Move to the next line. }π END;π Readln; { Pause for user. }π SetBlinkBit(FALSE); { Turn off blink bit. }π Readln; { Pause for user. }π SetBlinkBit(TRUE); { Turn blinkbit back on. }πEND.{BlinkBitDemo}π{*************************************************************}ππ 11 09-26-9309:26ALL MARTIN RICHARDSON Enable Blink/NOBLINK SWAG9311 6 ▐« {****************************************************************************π * Procedure ..... SetBlink;π * Purpose ....... To enable blinking vice intensityπ * Parameters .... Noneπ * Returns ....... Nothingπ * Notes ......... Colors with the background attribute high-bit set willπ * blink.π * Author ........ Martin Richardsonπ * Date .......... October 28, 1992π ****************************************************************************}πPROCEDURE SetBlink; ASSEMBLER;πASMπ MOV AX, 1003hπ MOV BL, 01hπ INT 10hπEND;π 12 09-26-9309:27ALL MARTIN RICHARDSON Enable Brite/NOBRITE SWAG9311 6 ▐« {****************************************************************************π * Procedure ..... SetBright;π * Purpose ....... To enable intensity vice blinkingπ * Parameters .... Noneπ * Returns ....... Nothingπ * Notes ......... Colors with the background attribute high-bit set willπ * show the background in bright colors.π * Author ........ Martin Richardsonπ * Date .......... October 28, 1992π ****************************************************************************}πPROCEDURE SetBright; ASSEMBLER;πASMπ MOV AX, 1003hπ XOR BL, BLπ INT 10hπEND;ππ 13 09-26-9309:25ALL MARTIN RICHARDSON Scroll Screen UP/DOWN SWAG9311 12 ▐« {****************************************************************************π * Procedure ..... Scroll()π * Purpose ....... Scroll the screen either up or downπ * Parameters .... nRow Top row of scroll areaπ * nCol Left column of scroll areaπ * nRows Number of rows in scroll areaπ * nCols Number of cols in scroll areaπ * nLines Number of lines to scrollπ * nDirect Direction to scroll in indicatorπ * nAttr Color attribute to leave behindπ * Returns ....... Nothingπ * Notes ......... A 0 for nDirect will scroll the screen up, a 1 willπ * scroll it down.π * Author ........ Martin Richardsonπ * Date .......... October 2, 1992π ****************************************************************************}πPROCEDURE Scroll( nRow, nCol, nRows, nCols, nLines, nDirect, nAttr: BYTE ); assembler;πASMπ MOV CH, nRowπ DEC CHπ MOV CL, nColπ DEC CLπ MOV DH, nRowsπ ADD DH, CHπ DEC DHπ MOV DL, nColsπ ADD DL, CLπ DEC DLπ MOV BH, nAttrπ MOV AL, nLInesππ MOV AH, nDirectπ AND AH, 1π OR AH, 6ππ INT 10hπEND;π 14 09-26-9309:07ALL ROBERT ROTHENBURG GUI - CRT Replacement SWAG9311 117 ▐« (*π===========================================================================π BBS: Beta ConnectionπDate: 09-21-93 (09:28) Number: 2846πFrom: ROBERT ROTHENBURG Refer#: 2648π To: GAYLE DAVIS Recvd: YES (PVT)πSubj: SWAG Submission (Part 1) Conf: (232) T_Pascal_Rπ---------------------------------------------------------------------------π->#643ππGayle,ππ Here's the GUI Unit I mentioned that I would submit for the SWAGπ reader a while back.ππ There's no documentation and a few things could be touched up,π but it works.ππ*)ππUnit GUI; (* Video and GUI Routines *)ππInterfaceππConstπ NormalCursor = $0D0E; (* Might be different on some systems *)π BlankCursor = $2000;ππTypeπ ScrBuffer = Array [0..1999] Of Word; (* Screen Buffer *)ππVarπ DirectVideoGUI: Boolean; (* define as TRUE if direct-video writing *)π Screen: Array [0..7] Of ScrBuffer Absolute $B800: 0000;ππProcedure SetActivePage (Page: Byte);πProcedure ScrollWindowUp (NoLines, Attrib, ColUL, RowUL, ColLR, RowLR: Byte);πProcedure ScrollWindowDn (NoLines, Attrib, ColUL, RowUL, ColLR, RowLR: Byte);πProcedure HLineCharAttrib (Page: Byte; CharAttrib: Word; xFrom, xTo, Y: Byte);πProcedure VLineCharAttrib (Page: Byte; CharAttrib: Word; X, yFrom, yTo: Byte);πFunction GetCharAttribXY (Page, X, Y: Byte): Word;πFunction GetCharAttrib (Page: Byte): Word;πProcedure PutCharAttrib (Page: Byte; CharAttrib: Word; NoChar: Word);πProcedure WriteChar (Page: Byte; CharAttrib: Word; NoChar: Word);πProcedure CWriteXY (Page, attrib, X, Y: Byte; n: String);πProcedure WriteXY (Page, attrib, X, Y: Byte; Var n: String);πProcedure WriteXYCh (Page, attrib, X, Y, c: Byte);πProcedure SetCursorPos (Page, Column, Row: Byte);πProcedure GetCursorPos (Var Page, Column, Row: Byte);πProcedure SetCursorType (ctype: Word);πFunction GetCursorType (Page: Byte): Word;ππProcedure InitDirect;πProcedure SavScr (Page: Byte; Var S: ScrBuffer);πProcedure ResScr (Page: Byte; Var S: ScrBuffer);ππFunction GetKeyCode: Word; (* Wait for Key from Buffer *)πFunction GetKeyFlags: Byte;πFunction PollKey (Var Status: Word): Word;πFunction GetKeyStroke: Word; (* Enhanced Keyboard? *)πFunction CheckKeyBoard: Word; (* Enhanced Keyboard? *)πProcedure WriteKey (KeyCode: Word; Var Status: Byte);ππProcedure WaitOnUser (Var Code, X, Y, Button: Word);πFunction InitMouse: Word;πProcedure ShowMouseCursor;πProcedure HideMouseCursor;πProcedure SetMouseWindow (X1, Y1, X2, Y2: Word);πProcedure GetMousePos (Var X, Y, button: Word);πProcedure SetMousePos (X, Y: Word);πProcedure GetButtonPressInfo (Var X, Y, Button, NumberOfPresses: Word);πProcedure GetButtonRelInfo (Var X, Y, Button, NumberOfReleases: Word);ππProcedure Frame (Page, X1, Y1, X2, Y2, c: Byte; Title: String);πProcedure Shadow (Page, X1, Y1, X2, Y2, cc: Byte);πProcedure FHLine (Page, Attrib, xFrom, xTo, Y: Byte);πProcedure FVLine (Page, Attrib, X, yFrom, yTo: Byte);πProcedure FrameReadLN (Var T: String; Page, X1, Y1, X2, Y2, cc: Byte);πProcedure Dialogue (Var T: String; Page, X1, Y1, X2, Y2, cc: Byte; Title: String);ππIMPLEMENTATIONππuses DOS;ππConstπ NUL = #00;π DEL = #08;π LF = #10;π CR = #13;π SP = #32;ππ VIO = $10; (* BIOS Video Interrupt *)π KBIO = $16; (* BIOS Keyboard *)π MIO = $33; (* Mouse Services *)πVar X, Y: Word;π reg: registers;π DTemp: ScrBuffer;ππfunction x80(y: word): word;πbeginπ asmπ MOV AX,yπ MOV BX,AXπ MOV CL,4π SHL BX,CLπ MOV CL,6π SHL AX,CLπ ADD AX,BXπ MOV @Result, AXπ endπend;ππfunction x80p(y,x: word): word;πbeginπ asmπ MOV AX,yπ MOV BX,AXπ MOV CL,4π SHL BX,CLπ MOV CL,6π SHL AX,CLπ ADD AX,BXπ ADD AX,xπ MOV @Result, AXπ endπend;ππProcedure WriteChar (Page: Byte; CharAttrib: Word; NoChar: Word);πBeginπ Asmπ MOV AX, CharAttribπ MOV BL, AHπ MOV AH, $0Aπ MOV BH, Pageπ MOV CX, NoCharπ Int VIOπ End;πEnd;ππProcedure PutCharAttrib (Page: Byte; CharAttrib: Word; NoChar: Word);πBeginπ Asmπ MOV AX, CharAttribπ MOV BL, AHπ MOV AH, $09π MOV BH, Pageπ MOV CX, NoCharπ Int VIOπ End;πEnd;ππFunction GetCharAttrib (Page: Byte): Word;πBeginπ Asmπ MOV AH, $08π MOV BH, Pageπ Int VIOπ MOV @Result, AXπ End;πEnd;ππProcedure InitDirect; (* CRT uses the variable "DirectVideo"... *)πBeginπ DirectVideoGUI := TrueπEnd;ππFunction GetCharAttribXY (Page, X, Y: Byte): Word;πBeginπ If DirectVideoGUIπ Then GetCharAttribXY := Screen [Page] [ x80p(Y,X)]π Else Beginπ Asmπ MOV AH, $02π MOV BH, Pageπ MOV DH, Yπ MOV DL, Xπ Int VIOπ MOV AH, $08π MOV BH, Pageπ Int VIOπ MOV @Result, AXπ Endπ End;πEnd;ππProcedure ScrollWindowUp (NoLines, Attrib, ColUL, RowUL, ColLR, RowLR: Byte);π Assembler;πAsmπ MOV AH, $06π MOV AL, NoLinesπ MOV BH, Attribπ MOV CH, RowULπ MOV CL, ColULπ MOV DH, RowLRπ MOV DL, ColLRπ Int VIOπEnd;ππProcedure ScrollWindowDn (NoLines, Attrib, ColUL, RowUL, ColLR, RowLR: Byte);πBeginπ Asmπ MOV AH, $07π MOV AL, NoLinesπ MOV BH, Attribπ MOV CH, RowULπ MOV CL, ColULπ MOV DH, RowLRπ MOV DL, ColLRπ Int VIOπ End;πEnd;ππProcedure SetActivePage (Page: Byte); Assembler;πAsmπ MOV AH, $05π MOV AL, Pageπ Int VIOπEnd;ππProcedure GetCursorPos (Var Page, Column, Row: Byte);πVar p, X, Y: Byte;πBeginπ p := Page;π Asmπ MOV AH, $03π MOV BH, pπ Int VIOπ MOV p, BHπ MOV X, DLπ MOV Y, DHπ End;π Page := p;π Column := X;π Row := Y;πEnd;ππFunction GetCursorType (Page: Byte): Word;πBeginπ Asmπ MOV AH, $03;π MOV BH, Pageπ Int VIOπ MOV @Result, CXπ End;πEnd;ππProcedure SetCursorPos (Page, Column, Row: Byte);πBeginπ Asmπ MOV AH, $02π MOV BH, Pageπ MOV DH, Rowπ MOV DL, Columnπ Int VIOπ End;πEnd;ππProcedure SetCursorType (ctype: Word);πBeginπ Asmπ MOV AH, $01π MOV CX, ctypeπ Int VIOπ End;πEnd;ππProcedure WriteXYCh (Page, attrib, X, Y, c: Byte);πBeginπ If DirectVideoGUIπ Then Screen [Page] [ x80p(Y,X) ] :=π (attrib ShL 8) + cπ Else Beginπ Asmπ MOV AH, $02π MOV BH, Pageπ MOV DL, Xπ MOV DH, Yπ Int VIOπ MOV AL, cπ MOV BL, Attribπ MOV AH, $09π MOV CX, 1π Int VIOπ Endπ EndπEnd;ππProcedure WriteXY (Page, attrib, X, Y: Byte; Var n: String);πVar i: byte;πBeginπ If n [0] <> #0π Then If DirectVideoGUIπ Then Beginπ For i := 1 To Length (n)π Do Screen [Page] [ x80p(Y,X+Pred (i)) ] := (attrib ShL 8) + Ord (n [i] );π Endπ Else Beginπ for i:=1 to Length(n)π doπ WriteXYCh(Page,Attrib,X+pred(i),y,ord(n[i]));πEndπEnd;ππProcedure CWriteXY (Page, attrib, X, Y: Byte; n: String);πBeginπ WriteXY (Page, attrib, X, Y, n);πEnd;ππProcedure HLineCharAttrib (Page: Byte; CharAttrib: Word; xFrom, xTo, Y: Byte);πBeginπ If DirectVideoGUIπ Then For X := x80p(Y, xFrom) To x80p(Y, xTo)π Do Screen [Page] [X] := CharAttribπ Else Beginπ SetCursorPos (Page, xFrom, Y);π PutCharAttrib (Page, CharAttrib, (xTo - xFrom) + 1)π EndπEnd;ππProcedure VLineCharAttrib (Page: Byte; CharAttrib: Word; X, yFrom, yTo: Byte);πVar Y: Byte;πBeginπ For Y := yFrom To yToπ Do If DirectVideoGUIπ Then Screen [Page] [ x80p(Y, X)] := CharAttribπ Else Beginπ SetCursorPos (Page, X, Y);π PutCharAttrib (Page, CharAttrib, 1)π EndπEnd;ππProcedure Frame (Page, X1, Y1, X2, Y2, c: Byte; Title: String);πBeginπ ScrollWindowUP (0, c, X1, Y1, X2, Y2); (* Must be on correct Page! *)π For X := X1 To X2π Do Beginπ WriteXYCh (Page, c, X, Y1, 196);π WriteXYCh (Page, c, X, Y2, 196)π End;π For Y := Y1 To Y2π Do Beginπ WriteXYCh (Page, c, X1, Y, 179);π WriteXYCh (Page, c, X2, Y, 179)π End;π WriteXYCh (Page, c, X1, Y1, 218);π WriteXYCh (Page, c, X2, Y1, 191);π WriteXYCh (Page, c, X1, Y2, 192);π WriteXYCh (Page, c, X2, Y2, 217);π If title <> ''π Then CWriteXY (Page, c, ( (X2 - X1) - (Length (title) + 2) ) Div 2, Y1, SP+Title);πEnd;ππProcedure FHLine (Page, Attrib, xFrom, xTo, Y: Byte);πBeginπ HLineCharAttrib (Page, (Attrib ShL 8) + 196, Succ (xFrom), Pred (xTo), Y);π WriteXYCh (Page, Attrib, xFrom, Y, 195);π WriteXYCh (Page, Attrib, xTo, Y, 180);πEnd;ππProcedure FVLine (Page, Attrib, X, yFrom, yTo: Byte);πBeginπ VLineCharAttrib (Page, (Attrib shl 8) + 179, X, Succ (yFrom), Pred (yTo) );π WriteXYCh (Page, Attrib, X, yFrom, 194);π WriteXYCh (Page, Attrib, X, yTo, 193);πEnd;πππProcedure SavScr (Page: Byte; Var S: ScrBuffer);πBeginπ If DirectVideoGUIπ Then Move (Screen, S [Page], 4000)π Elseπ asmπ MOV DL, 79π@I1: MOV DH, 24π@I0: MOV BH, Pageπ MOV AH,02π INT VIOπ MOV AH,08π INT VIOππ XCHG AX, DIπ XOR AX, AXπ MOV AL, DHπ MOV BX, AXπ MOV CL,4π SHL BX,CLπ MOV CL,6π SHL AX,CLπ ADD AX,BXπ CLCπ ADD AL,DLπ ADC AH,00π SHL AX,1π LDS SI, Sπ ADD SI,AXππ XCHG AX, DIπ MOV WORD PTR [SI],AXπ DEC DHπ CMP DH,-1π JNE @I0π DEC DLπ CMP DL,-1π JNE @I1π end;πEnd;ππProcedure ResScr (Page: Byte; var S: ScrBuffer);πBeginπ If DirectVideoGUIπ Then Move (S, Screen [Page], 4000)π Elseπ asmπ MOV DL, 79π@I1: MOV DH, 24π@I0: MOV BH, Pageπ MOV AH,02π INT VIOπ XOR AX, AXπ MOV AL, DHπ MOV BX, AXπ MOV CL,4π SHL BX,CLπ MOV CL,6π SHL AX,CLπ ADD AX,BXπ CLCπ ADD AL,DLπ ADC AH,00π SHL AX,1ππ LDS SI, Sπ ADD SI,AXππ MOV AX,WORD PTR [SI]π MOV BL, AHπ MOV BH, Pageπ MOV AH, 09π MOV CX, 1π int VIOπ DEC DHπ CMP DH,-1π JNE @I0π DEC DLπ CMP DL,-1π JNE @I1π end;πEnd;ππFunction GetKeyCode: Word;πBeginπ Asmπ MOV AH, $00π Int KBIOπ MOV @Result, AXπ End;πEnd;ππFunction PollKey (Var Status: Word): Word;πvar s: word;πBeginπ asmπ MOV AH, 01π INT KBIOπ MOV @Result, AXπ LAHFπ AND AX, 64π MOV S, AXπ end;π Status:=s;πEnd;ππFunction GetKeyStroke: Word;πBeginπ Asmπ MOV AH, $10π Int KBIOπ MOV @Result, AXπ End;πEnd;ππFunction CheckKeyBoard: Word;πBeginπ Asmπ MOV AH, $11π Int KBIOπ MOV @Result, AXπ End;πEnd;ππFunction GetKeyFlags: Byte;πBeginπ Asmπ MOV AH, $02π Int KBIOπ MOV @Result, ALπ End;πEnd;ππFunction GetKeyStatus: Word;πBeginπ Asmπ MOV AH, $12π Int KBIOπ MOV @Result, AXπ End;πEnd;ππProcedure WriteKey (KeyCode: Word; Var Status: Byte);πVar s: Byte;πBeginπ Asmπ MOV AH, $05π MOV CX, KeyCodeπ Int KBIOπ MOV s, ALπ End;π Status := s;πEnd;ππProcedure WaitOnUser (Var Code, X, Y, Button: Word);π (* wait for key or mouse click *)πVar Status: Word;πBeginπ Repeatπ Code := PollKey (Status);π GetMousePos (X, Y, Button);π Until (Button <> 0) Or (Status = 0);πEnd;ππFunction InitMouse: Word;πBeginπ Asmπ MOV AX, $0000π Int MIOπ MOV @Result, AXπ End;πEnd;ππProcedure ShowMouseCursor; Assembler;πAsmπ MOV AX, $0001π Int MIOπEnd;ππProcedure HideMouseCursor; Assembler;πAsmπ MOV AX, $0002π Int MIOπEnd;ππProcedure GetMousePos (Var X, Y, Button: Word);πVar X1, Y1, b: Word;πBeginπ Asmπ MOV AX, $0003π Int MIOπ MOV b, BXπ MOV X1, CXπ MOV Y1, DXπ End;π X := X1;π Y := Y1;π Button := b;πEnd;ππProcedure SetMousePos (X, Y: Word); Assembler;πAsmπ MOV AX, $0004π MOV CX, Xπ MOV DX, Yπ Int MIOπEnd;ππProcedure GetButtonPressInfo (Var X, Y, Button, NumberOfPresses: Word);πBeginπ reg. AX := $0005;π reg. BX := Button;π Intr (MIO, reg);π Button := reg. AX;π X := reg. CX;π Y := reg. DX;π NumberOfPresses := reg. BXπEnd;ππProcedure GetButtonRelInfo (Var X, Y, Button, NumberOfReleases: Word);πBeginπ reg. AX := $0006;π reg. BX := Button;π Intr (MIO, reg);π Button := reg. AX;π X := reg. CX;π Y := reg. DX;π NumberOfReleases := reg. BXπEnd;ππProcedure SetMouseWindow (X1, Y1, X2, Y2: Word);πBeginπ reg. AX := $0007;π reg. CX := X1;π reg. DX := X2;π Intr ($33, reg);π Inc (reg. AX, 1);π reg. CX := Y1;π reg. DX := Y2;π Intr (MIO, reg)πEnd;πππProcedure Shadow (Page, X1, Y1, X2, Y2, cc: Byte);πBeginπ HLineCharAttrib (Page, (cc * $100) + $B1, Succ (X1), Succ (X2), Succ (Y2) );π VLineCharAttrib (Page, (cc * $100) + $B1, Succ (X2), Succ (Y1), Succ (Y2) );πEnd;ππProcedure Dialogue (Var T: String; Page, X1, Y1, X2, Y2, cc: Byte; Title: String);πBeginπ SavScr (Page, DTemp);π Frame (Page, X1, Y1, X2, Y2, cc, ''); Title := SP + Title + SP;π WriteXY (Page, cc, Succ (X1), Y1, Title);π FrameReadLN (T, Page, Succ (X1), Succ (Y1), Pred (X2), Pred (Y2), cc);π ResScr (Page, DTemp)πEnd;ππProcedure FrameReadLN (Var T: String; Page, X1, Y1, X2, Y2, cc: Byte);πVar i, X, Y, z: Byte;π Code: Word;π C: Char;πBeginπ X := X1; Y := Y1;π If T [0] <> #0π Then For i := 0 To Pred (Ord (T [0] ) )π Do WriteXYCh (Page, cc, (i Mod (X2 - X1) ) + X1, (i Div (X2 - X1) ) + Y1, Ord(T[0]));π SetCursorType (NormalCursor);π i := 0;π Repeatπ SetCursorPos (Page, X, Y);π Code := GetKeyCode;π C := Chr (Lo (Code) );π If C = NULπ Then Beginπ Case Hi (Code) Ofπ $4B: If i <> 0 Then Dec (i);π $4D: If i < Ord (T [0] ) Then Inc (i);π $47: i := 0;π $4F: i := Ord (T [0] );π { $53:if i<ord(T[0]) then beginπ if i>1π then T:=Copy(T,1,pred(i))+Copy(T,succ(i),255)π else if i<>ord(T[0])π then T:=Copy(T,2,255)π else T:=Copy(T,1,pred(i));π for z:=i to ord(T[0])π do WriteXY(Page,cc,(z mod (x2-x1))+x1,(z div (x2-x1))+y1,T[z]);π WriteXY(Page,cc,(succ(z) mod (x2-x1))+x1,π (succ(z) div (x2-x1))+y1,SP);π end; }π End;π X := (i Mod (X2 - X1) ) + X1;π Y := (i Div (X2 - X1) ) + Y1π Endπ Else If C <> CRπ Then If (i < 255) And (Y <= Y2)π Then If C <> DELπ Then Beginπ Inc (i);π T [i] := C;π If i > Ord (T [0] )π Then Inc (T [0], 1);π WriteXYCh (Page, cc, X, Y, Ord (C) );π Inc (X);π If X = X2π Then Beginπ Inc (Y);π X := X1π Endπ Endπ Else If (i <> 0) And (i = Ord (T [0] ) )π Then Beginπ { if i<ord(T[0])π then T:=Copy(T,1,pred(i))+Copy(T,succ(i),255);}π Dec (i);π Dec (T [0], 1);π If X = X1π Then Beginπ X := Pred (X2);π Dec (Y)π Endπ Else Dec (X);π If i = Ord (T [0] )π Then WriteXYCh (Page, cc, X, Y, 32)π { else beginπ for z:=i to ord(T[0])π do WriteXY(Page,cc,(z mod (x2-x1))+x1,(z div (x2-x1))+y1,T[z]);π WriteXY(Page,cc,(succ(z) mod (x2-x1))+x1,π (succ(z) div (x2-x1))+y1,SP);π x:=(i mod (x2-x1))+x1;π y:=(i div (x2-x1))+y1π end }π Endπ Until C = CR;π SetCursorType (BlankCursor);πEnd;ππEnd.π---π * Your Software Resource * Selden NY * 516-736-6662π * PostLink(tm) v1.07 YOURSOFTWARE (#5190) : RelayNet(tm)π 15 11-26-9318:16ALL SWAG SUPPORT GROUP Set High Background SWAG9311 12 ▐« >Actually James you are in correct. Here is some code that will change theπ>blinking characters to a enhanced back ground...π> π>Procedure HighBackGround;π>VARπ> R: Registers; {You must use the Dos Unit.}π>BEGINπ> WITH R DOπ> BEGINπ> R.AH:=$10;π> R.AL:=$03;π> BL:=0;π> {0 for intense back ground}π> {1 for blink}π> END;π> Intr($10,R);π>END;π> π>Hope this helps,π> ππ This solution is correct, but only for EGA or higher monitors. ππ To get high intensity background colors on a CGA card, you need toπ access the Color Graphics Mode Control Register, port $3d8.ππ The bit meanings are as follows:ππ bitππ 7,6 unusedπ 5 blink mode 0 = disable blink 1 = enable blinkπ 4 graphics resolution 0 = 320x200 1 = 640x200π 3 video enable 0 = disable 1 = enableπ 2 color mode 0 = color 1 = bwπ 1 monitor mode 0 = alphanumeric 1 = graphicsπ 0 char. size 0 = 40x25 1 = 80x25ππ The simplist answer to your problem is, in TP, ππ port[$3d8] := $9ππ This sets 80x25 color alphanumeric mode with high intensityπ background colors. If you need other modes, set the bitsπ accordingly. ππ One word of caution: register $3d8 is write only, so you can'tπ use the read-or-write method of bit setting. You'll need to lookπ into the BIOS data area to find out the current video mode ifπ necessary.π 16 11-26-9318:16ALL SWAG SUPPORT GROUP Toggle Blink On/Off SWAG9311 2 ▐« procedure ToggleBlink(OnOff:boolean);πassembler;πasmπ mov ax,1003hπ mov bl,OnOffπ int 10hπend;π 17 11-02-9305:28ALL SWAG SUPPORT TEAM CRT Clone SWAG9311 52 ▐« {π Well here it is again, its a little rough and some of the Crt.tpu Functionsπare left out. This Unit will generate Ansi TextColor and TextBackGrounds.πBecuase of the Ansi screen Writes you can send the Program to the com portπjust by using CTTY or GateWay in a bat File before you start your Program.π}ππUnit CrtClone;ππInterfaceππConstπ { Foreground and background color Constants }π Black = 0;π Blue = 1;π Green = 2;π Cyan = 3;π Red = 4;π Magenta = 5;π Brown = 6;π LightGray = 7;ππ { Foreground color Constants }π DarkGray = 8;π LightBlue = 9;π LightGreen = 10;π LightCyan = 11;π LightRed = 12;π LightMagenta = 13;π Yellow = 14;π White = 15;ππ { Add-in For blinking }π Blink = 128;ππVarπ { Interface Variables }π CheckBreak : Boolean; { Enable Ctrl-Break }π CheckEOF : Boolean; { Enable Ctrl-Z }ππProcedure TextColor(Color : Byte);πProcedure TextBackground(Color : Byte);πFunction KeyPressed : Boolean;πFunction GetKey : Char;πFunction ReadKey : Char;πFunction WhereX : Byte;πFunction WhereY : Byte;πProcedure NormVideo;πProcedure ClrEol;πProcedure ClrScr;πProcedure GotoXY(X, Y : Byte);πππImplementationππFunction KeyPressed : Boolean;π{ Replacement For Crt.KeyPressed }π{ ;Detects whether a key is pressed}π{ ;Does nothing With the key}π{ ;Returns True if key is pressed}π{ ;Otherwise, False}π{ ;Key remains in kbd buffer}πVarπ IsThere : Byte;πbeginπ Inline(π $B4/$0B/ { MOV AH,+$0B ;Get input status}π $CD/$21/ { INT $21 ;Call Dos}π $88/$86/>ISTHERE); { MOV >IsThere[BP],AL ;Move into Variable}π KeyPressed := (IsThere = $FF);πend;ππProcedure ClrEol; { ANSI replacement For Crt.ClrEol }πbeginπ Write(#27'[K');πend;ππProcedure ClrScr; { ANSI replacement For Crt.ClrScr }πbeginπ Write(#27'[2J');πend;ππFunction GetKey : Char; { Additional Function. Not in Crt Unit }πVarπ CH : Char;πbeginπ Inline(π {; Function GetKey : Char}π {; Clears the keyboard buffer then waits Until}π {; a key is struck. if the key is a special, e.g.}π {; Function key, goes back and reads the next}π {; Byte in the keyboard buffer. Thus does}π {; nothing special With Function keys.}π $B4/$0C { MOV AH,$0C ;Set up to clear buffer}π /$B0/$08 { MOV AL,8 ;then to get a Char}π /$CD/$21 {SPCL: INT $21 ;Call Dos}π /$3C/$00 { CMP AL,0 ;if it's a 0 Byte}π /$75/$04 { JNZ CHRDY ;is spec., get second Byte}π /$B4/$08 { MOV AH,8 ;else set up For another}π /$EB/$F6 { JMP SHORT SPCL ;and get it}π /$88/$46/>CH {CHRDY: MOV >CH[BP],AL ;else put into Function return}π );π if CheckBreak and (Ch = #3) thenπ begin {if CheckBreak is True and it's a ^C}π Inline( {then execute Ctrl_Brk}π $CD/$23);π end;π GetKey := Ch;πend; {Inline Function GetKey}πππFunction ReadKey : Char; { Replacement For Crt.ReadKey }πVarπ chrout : Char;πbeginπ { ;Just like ReadKey in Crt Unit}π Inline(π $B4/$07/ { MOV AH,$07 ;Char input w/o echo}π $CD/$21/ { INT $21 ;Call Dos}π $88/$86/>CHROUT); { MOV >chrout[bp],AL ;Put into Variable}π if CheckBreak and (chrout = #3) then {if it's a ^C and CheckBreak True}π {then execute Ctrl_Brk}π Inline($CD/$23); { INT $23}π ReadKey := chrout; {else return Character}πend;ππFunction WhereX : Byte; { ANSI replacement For Crt.WhereX }πVar { Cursor position report. This is column or }π ch : Char; { X axis report.}π st : String;π st1 : String[2];π x : Byte;π i : Integer;πbeginπ Write(#27'[6n'); { Ansi String to get X-Y position }π st := ''; { We will only use X here }π ch := #0; { Make sure Character is not 'R' }π While ch <> 'R' do { Return will be }π begin { Esc - [ - Ypos - ; - Xpos - R }π ch := #0;π ch := ReadKey; { Get one }π st := st + ch; { Build String }π end;π St1 := copy(St,6,2); { Pick off subString having number in ASCII}π Val(St1,x,i); { Make it numeric }π WhereX := x; { Return the number }πend;ππFunction WhereY : Byte; { ANSI replacement For Crt.WhereY }πVar { Cursor position report. This is row or }π ch : Char; { Y axis report.}π st : String;π st1 : String[2];π y : Byte;π i : Integer;πbeginπ Write(#27'[6n'); { Ansi String to get X-Y position }π st := ''; { We will only use Y here }π ch := #0; { Make sure Character is not 'R' }π While ch <> 'R' do { Return will be }π begin { Esc - [ - Ypos - ; - Xpos - R }π ch := #0;π ch := ReadKey; { Get one }π st := st + ch; { Build String }π end;π St1 := copy(St,3,2); { Pick off subString having number in ASCII}π Val(St1,y,i); { Make it numeric }π WhereY := y; { Return the number }πend;πππProcedure GotoXY(x : Byte ; y : Byte); { ANSI replacement For Crt.GoToXY}πbeginπ if (x < 1) or (y < 1) thenπ Exit;π if (x > 80) or (y > 25) thenπ Exit;π Write(#27'[', y, ';', x, 'H');πend;ππProcedure TextBackGround(Color : Byte);πbeginπ Case color ofπ 0 : Write(#27#91#52#48#109);π 1 : Write(#27#91#52#52#109);π 2 : Write(#27#91#52#50#109);π 3 : Write(#27#91#52#54#109);π 4 : Write(#27#91#52#49#109);π 5 : Write(#27#91#52#53#109);π 6 : Write(#27#91#52#51#109);π 6 : Write(#27#91#52#55#109);π end;πend;ππProcedure TextColor(Color : Byte);π beginπ Case color ofπ 0 : Write(#27#91#51#48#109);π 1 : Write(#27#91#51#52#109);π 2 : Write(#27#91#51#50#109);π 3 : Write(#27#91#51#54#109);π 4 : Write(#27#91#51#49#109);π 5 : Write(#27#91#51#53#109);π 6 : Write(#27#91#51#51#109);π 7 : Write(#27#91#51#55#109);π 8 : Write(#27#91#49#59#51#48#109);π 9 : Write(#27#91#49#59#51#52#109);π 10 : Write(#27#91#49#59#51#50#109);π 11 : Write(#27#91#49#59#51#54#109);π 12 : Write(#27#91#49#59#51#49#109);π 13 : Write(#27#91#49#59#51#53#109);π 14 : Write(#27#91#49#59#51#51#109);π 15 : Write(#27#91#49#59#51#55#109);π 128 : Write(#27#91#53#109);π end;πend;ππProcedure NormVideo;πbeginπ Write(#27#91#48#109);πend;ππend.π
